home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / libraries / dylan / stretchy.dylan < prev    next >
Encoding:
Text File  |  1995-03-15  |  6.5 KB  |  238 lines  |  [TEXT/ttxt]
  1. module: dylan
  2. rcs-header: $Header: stretchy.dylan,v 1.10 94/11/03 23:51:10 wlott Exp $
  3.  
  4. //======================================================================
  5. //
  6. // Copyright (c) 1994  Carnegie Mellon University
  7. // All rights reserved.
  8. // 
  9. // Use and copying of this software and preparation of derivative
  10. // works based on this software are permitted, including commercial
  11. // use, provided that the following conditions are observed:
  12. // 
  13. // 1. This copyright notice must be retained in full on any copies
  14. //    and on appropriate parts of any derivative works.
  15. // 2. Documentation (paper or online) accompanying any system that
  16. //    incorporates this software, or any part of it, must acknowledge
  17. //    the contribution of the Gwydion Project at Carnegie Mellon
  18. //    University.
  19. // 
  20. // This software is made available "as is".  Neither the authors nor
  21. // Carnegie Mellon University make any warranty about the software,
  22. // its performance, or its conformity to any specification.
  23. // 
  24. // Bug reports, questions, comments, and suggestions should be sent by
  25. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  26. //
  27. //======================================================================
  28. //
  29. //  This file implements stretchy-vectors.
  30. //
  31.  
  32.  
  33. //// <stretchy-vector>
  34.  
  35. define class <stretchy-vector> (<stretchy-collection>, <vector>)
  36.   //
  37.   // No slots in the abstract class <stretchy-vector>
  38. end class <stretchy-vector>;
  39.  
  40. define method make(cls == <stretchy-vector>, #rest keys, #all-keys)
  41.   apply(make, <simple-stretchy-vector>, keys);
  42. end method;
  43.  
  44.  
  45.  
  46. //// <simple-stretchy-vector>
  47.  
  48. define class <simple-stretchy-vector> (<stretchy-vector>)
  49.   slot ssv-data :: <simple-object-vector>, init-keyword: data:;
  50.   slot ssv-fill :: <fixed-integer>, init-keyword: fill:;
  51. end class <simple-stretchy-vector>;
  52.   
  53.  
  54. define method make(cls == <simple-stretchy-vector>,
  55.            #next next-method,
  56.            #key size: sz = #f, fill, dimensions)
  57.   if (sz & dimensions)
  58.     error("Can't supply both a size: and dimensions:");
  59.   else
  60.     let size = case
  61.          sz => sz;
  62.          ~dimensions => 0;
  63.          size(dimensions) = 1 =>
  64.            first(dimensions);
  65.          otherwise =>
  66.            error("Vectors can only have one dimension.");
  67.            end case;
  68.     let data-size = case
  69.               size < 0 =>
  70.             error("size: can't be negative.");
  71.               size < 16 => 16;
  72.               size < 1024 =>
  73.             for (data-size = 16 then data-size * 2,
  74.                  until size < data-size)
  75.             finally data-size;
  76.             end for;
  77.               otherwise =>
  78.             ceiling(size + 1024, 1024) * 1024;
  79.             end case;
  80.     let data = make(<simple-object-vector>, size: data-size);
  81.     fill!(data, fill, end: data-size);
  82.     next-method(cls, fill: size, data: data);
  83.   end if;
  84. end method make;
  85.  
  86. define method size(ssv :: <simple-stretchy-vector>) => <fixed-integer>;
  87.   ssv-fill(ssv);
  88. end method size;
  89.  
  90. define method size-setter(new :: <fixed-integer>, ssv :: <simple-stretchy-vector>)
  91.   let fill = ssv-fill(ssv);
  92.   let data = ssv-data(ssv);
  93.   if (new > fill)
  94.     let len = size(data);
  95.     if (new > len)
  96.       let new-len = if (new < 1024)
  97.               for (new-len = 16 then new-len * 2,
  98.                until new < new-len)
  99.               finally new-len;
  100.               end for;
  101.             else 
  102.               ceiling(new + 1024, 1024) * 1024;
  103.             end if;
  104.       let new-data = make(<simple-object-vector>, size: new-len);
  105.       for (index from 0 below fill)
  106.     new-data[index] := data[index];
  107.       end for;
  108.       ssv-data(ssv) := new-data;
  109.     end if;
  110.     fill!(data, #f, start: fill);
  111.   else
  112.     fill!(data, #f, start: new, end: fill);
  113.   end if;
  114.   ssv-fill(ssv) := new;
  115. end method size-setter;
  116.  
  117. define method dimensions(ssv :: <simple-stretchy-vector>) => <list>;
  118.   list(size(ssv));
  119. end method dimensions;
  120.  
  121.  
  122. define constant ssv_no_default = pair(#f, #f);
  123.  
  124. define method element(ssv :: <simple-stretchy-vector>, key :: <fixed-integer>,
  125.               #key default = ssv_no_default)
  126.   case
  127.     key >= 0 & key < size(ssv) =>
  128.       ssv-data(ssv)[key];
  129.     default == ssv_no_default =>
  130.       error("Element %d not in %=", key, ssv);
  131.     otherwise =>
  132.       default;
  133.   end case;
  134. end method element;
  135.  
  136. define method element-setter(value, ssv :: <simple-stretchy-vector>,
  137.                  key :: <fixed-integer>)
  138.   if (key < 0)
  139.     error("Element %d not in %=", key, ssv);
  140.   else
  141.     if (key >= size(ssv))
  142.       size(ssv) := key + 1;
  143.     end if;
  144.     ssv-data(ssv)[key] := value;
  145.   end if;
  146. end method element-setter;
  147.  
  148. define method add!(ssv :: <simple-stretchy-vector>, new-element)
  149.   let data = ssv-data(ssv);
  150.   let fill = size(ssv);
  151.   if (fill = size(data))
  152.     let data-size = if (fill < 1024)
  153.               fill * 2;
  154.             else 
  155.               fill + 1024;
  156.             end if;
  157.     let new-data = replace-subsequence!(make(<simple-object-vector>,
  158.                          size: data-size),
  159.                     data, end: fill);
  160.     ssv-data(ssv) := new-data;
  161.     new-data[fill] := new-element;
  162.   else 
  163.     data[fill] := new-element;
  164.   end if;
  165.   ssv-fill(ssv) := fill + 1;
  166.   ssv;
  167. end method add!;
  168.  
  169. define method remove!(ssv :: <simple-stretchy-vector>, elem,
  170.               #key test = \==, count)
  171.   unless (count & (count = 0))
  172.     let data = ssv-data(ssv);
  173.     let sz = size(ssv);
  174.     local
  175.       method copy(src, dst, deleted)
  176.     case
  177.       src = sz =>
  178.         ssv-fill(ssv) := sz - deleted;
  179.       otherwise =>
  180.         data[dst] := data[src];
  181.         copy(src + 1, dst + 1, deleted);
  182.     end case;
  183.       end method copy,
  184.       method search-and-copy(src, dst, deleted)
  185.     if (src = sz)
  186.       ssv-fill(ssv) := sz - deleted;
  187.     else 
  188.       let this-element = data[src];
  189.       case
  190.         test(this-element, elem) =>
  191.           let deleted = deleted + 1;
  192.           if (count & (deleted = count))
  193.         copy(src + 1, dst, deleted);
  194.           else
  195.         search-and-copy(src + 1, dst, deleted);
  196.           end if;
  197.         otherwise =>
  198.           data[dst] := data[src];
  199.           search-and-copy(src + 1, dst + 1, deleted);
  200.       end case;
  201.     end if;
  202.       end method search-and-copy,
  203.       method search(src)
  204.     unless (src = sz)
  205.       let this-element = data[src];
  206.       if (test(this-element, elem))
  207.         if (count & (count = 1))
  208.           copy(src + 1, src, 1);
  209.         else 
  210.           search-and-copy(src + 1, src, 1);
  211.         end if;
  212.       else
  213.         search(src + 1);
  214.       end if;
  215.     end unless;
  216.       end method search;
  217.  
  218.     search(0);
  219.   end unless;
  220.   ssv;
  221. end method remove!;
  222.  
  223. define method map-into(destination :: <stretchy-vector>,
  224.                proc :: <function>, sequence :: <sequence>,
  225.                #next next_method, #rest more_sequences)
  226.   if (empty?(more_sequences))
  227.     let sz = size(sequence);
  228.     if (sz > size(destination)) size(destination) := sz end if;
  229.     let data = ssv-data(destination);
  230.     for (key from 0, elem in sequence)
  231.       destination[key] := proc(elem);
  232.     end for;
  233.     destination;
  234.   else
  235.     next_method();
  236.   end if;
  237. end method map-into;
  238.